home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / IFF / unpacking < prev   
Encoding:
Text File  |  1991-09-21  |  3.6 KB  |  171 lines
  1. \ Unpacking Routine needed by IFF files
  2. \
  3. \ Unpacks Run-Length-Encoded data.
  4. \ Can be used to unpack IFF data in "cmpByteRun1" form.
  5. \
  6. \ Technique:
  7. \   Normal Data is stored as a positive count followed
  8. \      by N+1 bytes of data.
  9. \   Redundant data is stored as a negative count
  10. \      followed by the byte to be repeated 1-N times.
  11. \
  12. \ Translated from 'C' by Phil Burk
  13. \
  14. \ Original By Jerry Morrison and Steve Shaw, Electronic Arts.
  15. \ Author: Phil Burk
  16. \ Copyright 1988 Phil Burk
  17. \ All Rights reserved
  18.  
  19. decimal
  20. exists? includes
  21. .IF  getmodule includes
  22. .ELSE include? bm_rows ji:graphics/gfx.j
  23. .THEN
  24. include? { ju:locals
  25.  
  26. ANEW TASK-UNPACKING
  27.  
  28. ASM UNPACKROW ( src dst #src #dst -- src' dst' #src' error? )
  29. \ Register Usage
  30. \ D0 = source count
  31. \ D1 = destination count
  32. \ D2 = count/opcode
  33. \ A0 = source
  34. \ A1 = destination
  35. \ TOS = scratch
  36.     move.l    tos,d1
  37.     move.l    (a6)+,d0
  38.     move.l    (a6)+,a1
  39.     adda.l    org,a1        \ Convert to absolute
  40.     move.l    (a6)+,a0
  41.     adda.l    org,a0
  42. \
  43. 1$:    cmp.l    #0,d1        \ room left in dst?
  44.     ble.s    6$
  45.     subq.l    #1,d0        \ data left
  46.     blt.s    5$        \ error if run out
  47. \
  48.     moveq.l    #0,d2
  49.     move.b    (a0)+,d2    \ get next source byte
  50.     blt.s    3$
  51. \ -----------------------------------------
  52. \ Copy normal data if less than 128
  53.     addq.l    #1,d2        \ N+1 bytes
  54.     sub.l    d2,d0        \ update pointers
  55.     blt.s    5$
  56.     sub.l    d2,d1
  57.     blt.s    5$
  58. \
  59. \ Move literal bytes from source to destination
  60.     subq.l    #1,d2        \ adjust for dbrq
  61. 2$:    move.b    (a0)+,(a1)+
  62.     dbra.w    d2,2$
  63.     bra.s    1$
  64. \
  65. \ -----------------------------------------
  66. \ Copy many of the same bytes.
  67. 3$:    cmp.b    #$80,d2
  68.     beq.l    1$        \ NOOP if $80  ( -128)
  69.     move.l    #$101,tos
  70.     sub.l    d2,tos        \ tricky 1-N
  71.     subq.l    #1,d0        \ one from source
  72.     blt.s    5$
  73.     sub.l    tos,d1        \ bytes from dst
  74.     blt.s    5$
  75. \
  76.     move.b    (a0)+,d2    \ copy redundant data byte
  77.     subq.l    #1,tos        \ adjust for DBRA
  78. 4$:    move.b    d2,(a1)+
  79.     dbra.w    tos,4$
  80.     bra.s    1$
  81. \ ----------------------------------
  82. 5$:    move.l    #-1,tos        \ error return
  83.     bra.s    7$
  84. \
  85. 6$:    moveq.l    #0,tos        \ normal return
  86. 7$:    sub.l    org,a0
  87.     move.l    a0,-(dsp)
  88.     sub.l    org,a1
  89.     move.l    a1,-(dsp)
  90.     move.l    d0,-(dsp)
  91.     rts
  92. END-CODE
  93.  
  94. \ Test Unpacker ----------------------------------
  95. false .IF
  96.  
  97. hex
  98. CREATE SRCROW
  99.     4 c, 11 c, 22 c, 33 c, 44 c, 55 c,
  100.     -4 c, 66 c,  80 c, 1 c, 77 c, 88 c,
  101. decimal
  102.  
  103. CREATE DSTROW 256 allot
  104. : TUN
  105.     dstrow 100 erase
  106.     srcrow dstrow 12 12 unpackrow .s
  107.     dstrow 20 dump
  108. ;
  109. .THEN
  110.  
  111. \ Unpack BITMAPs ----------------------------------------
  112. : COPYROW { src dst src_many dst_many -- src' dst' src_many' error? }
  113.     src_many dst_many <
  114.     IF  src dst src_many true
  115.     ELSE  src dst dst_many move  ( just move bytes !! )
  116.         src dst_many + ( src' )
  117.         dst dst_many + ( dst' )
  118.         src_many dst_many -  ( src_many' )
  119.         false
  120.     THEN
  121. ;
  122.  
  123. \ Compression form 1 is Run length encoded.
  124. \ Body form 0 is uncompressed.
  125. : BODY>BITMAP  { bodyptr bsize bmap compr | bresult -- bmap | NULL }
  126.     compr 0= compr 1 = OR 0=
  127.     IF ." Illegal compression = " compr . 0 exit
  128.     THEN
  129.     bmap -> bresult
  130.     bmap ..@ bm_rows 0  ( for each row )
  131.     DO bmap ..@ bm_depth 0 ( for each plane )
  132.     DO  bodyptr  ( source )
  133. \ next plane base
  134.         bmap .. bm_planes i cells + @ >rel
  135. \ offset to row
  136.         j bmap ..@ bm_bytesperrow * +
  137.         ( -- data current-row )
  138.         bsize
  139.         bmap ..@ bm_bytesperrow
  140.             compr 0=
  141.             IF copyrow
  142.             ELSE unpackrow ( -- s d #s e )
  143.             THEN
  144.         IF .s 2drop drop
  145.             0 -> bresult
  146.             leave
  147.         THEN
  148.         -> bsize
  149.         drop
  150.         -> bodyptr
  151.     LOOP
  152.     bresult 0= IF leave THEN
  153.     LOOP
  154.     bresult
  155. ;
  156.  
  157. : CMAP>CTABLE ( color-map color-table #entries -- , pack )
  158. \ Pack Color Map data (3 bytes/RGB) to colortable.
  159.     >r swap r>
  160.     0
  161.     DO  ( -- ct cm )
  162.     0 3 0
  163.     DO  ( -- ct cm accum )
  164.         4 ashift
  165.         over c@ -4 ashift +
  166.         swap 1+ swap ( -- ct cm+1 accum )
  167.     LOOP  ( -- ct cm+3 rgb4 )
  168.     2 pick i 2* + w!
  169.     LOOP 2drop
  170. ;
  171.